home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 4 / United Public Domain Gold 4.iso / fredfish / ff.0981.dms / ff.0981.adf / CloudsAGA / Clouds.mod next >
Text File  |  1994-04-05  |  31KB  |  753 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    CloudsAGA.mod
  3.     :Author.     Daniel Amor
  4.     :Address.    Ludwigstr. 124, D-70197 Stuttgart
  5.     :Shortcut.   [da]
  6.     :Version.    1.05
  7.     :Date.       15-Feb-94
  8.     :Copyright.  PD
  9.     :Language.   Oberon-2
  10.     :Translator. Amiga Oberon 3.0
  11.     :Imports.    Clouds [da].
  12.     :Contents.   Erzeugt Fraktal-Wolken.
  13.     :Remark.     Aufruf: Clouds
  14. ---------------------------------------------------------------------------*)
  15.  
  16. MODULE Clouds;
  17.  
  18. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- $TypeChk- *)
  19.  
  20. IMPORT  e    : Exec,
  21.         d    : Dos,
  22.         I    : Intuition,
  23.         gt   : GadTools,
  24.         g    : Graphics,
  25.         req  : Requests,
  26.         GUI  : CloudsGUI,
  27.         u    : Utility,
  28.         r    : Random,
  29.         y    : SYSTEM,
  30.         str  : Strings,IFF,ASL;
  31.  
  32. CONST UntereFarbe   = 4;
  33.  
  34. TYPE colourstype32  = ARRAY 86  OF LONGINT;
  35.      colourstype64  = ARRAY 182 OF LONGINT;
  36.      colourstype128 = ARRAY 386 OF LONGINT;
  37.      colourArray    = ARRAY 31 OF INTEGER;
  38.  
  39. VAR quit,open,gOK                 : BOOLEAN;
  40.     msgptr,msgptr1,msgptr2        : I.IntuiMessagePtr;
  41.     msg,msg1,msg2                 : I.IntuiMessage;
  42.     item1,item2                   : I.MenuItemPtr;
  43.     aktgad1,aktgad2               : I.GadgetPtr;
  44.     vp                            : g.ViewPortPtr;
  45.     nummer,farbe,na,fonty,size,version    : INTEGER;
  46.     win                           : I.WindowPtr;
  47.     Scr2                          : I.ScreenPtr;
  48.     depth,resx,resy               : LONGINT;
  49.     key                           : CHAR;
  50.     wx,wy,ObereFarbe,MittlereFarbe: INTEGER;
  51.     colours32                     : colourstype32;
  52.     colours64                     : colourstype64;
  53.     colours128                    : colourstype128;
  54.     VERSION                       : ARRAY 90 OF CHAR;
  55.     Col32,Col32copy : colourstype128;
  56.     colourNoAGA,colourNoAGAcopy : colourArray;
  57.  
  58. PROCEDURE FileReq(hail: ARRAY OF CHAR; VAR name: ARRAY OF CHAR; win : I.WindowPtr): BOOLEAN;
  59.  
  60. VAR i,j       : INTEGER;
  61.     Dirname   : ARRAY 256 OF CHAR;
  62.     Filename  : ARRAY 356 OF CHAR;
  63.     flags     : LONGINT;
  64.     res       : BOOLEAN;
  65.     fr        : ASL.FileRequesterPtr;
  66.     pattern   : ARRAY 80 OF CHAR;
  67.  
  68. BEGIN
  69.   j := SHORT(str.Length(name));
  70.   WHILE (j>=0) & (name[j]#":") & (name[j]#"/") DO DEC(j) END;
  71.   i := 0;
  72.   WHILE i<=j DO Dirname[i] := name[i]; INC(i) END; Dirname[i] := 0X;
  73.   j := 0;
  74.   REPEAT Filename[j] := name[i]; INC(j); INC(i) UNTIL name[i-1]=0X;
  75.   fr := ASL.AllocAslRequestTags(ASL.fileRequest, u.done);
  76.   IF fr=NIL THEN HALT(20) END;
  77.   flags := ASH(1,ASL.patGad);
  78.   INC(flags,ASH(1,ASL.save));
  79.   res := ASL.AslRequestTags(fr, ASL.hail,     y.ADR(hail),
  80.                                 ASL.file,     y.ADR(Filename),
  81.                                 ASL.dir,      y.ADR(Dirname),
  82.                                 ASL.window,   win,
  83.                                 ASL.pattern,  y.ADR(pattern),
  84.                                 ASL.funcFlags,flags,
  85.                                 u.done);
  86.   COPY(fr.dir^,Dirname);
  87.   COPY(fr.file^,Filename);
  88.  
  89.   i := SHORT(str.Length(Dirname));
  90.   IF (i>0) & (Dirname[i-1]#"/") & (Dirname[i-1]#":") THEN
  91.     Dirname[i] := "/"; INC(i);
  92.     Dirname[i] := 0X;
  93.   END;
  94.   IF LEN(name)>i+str.Length(Filename) THEN
  95.     COPY(Dirname,name);
  96.     str.Append(name,Filename);
  97.     RETURN TRUE;
  98.   END;
  99.   RETURN FALSE;
  100. END FileReq;
  101.  
  102. PROCEDURE OpenWindow (left,top,width,height: LONGINT; VAR win: I.WindowPtr);
  103.  
  104. VAR quit: BOOLEAN;
  105.  
  106. BEGIN
  107.   IF height<resy-GUI.FontY THEN top:=GUI.FontY+3 END;
  108.   win := I.OpenWindowTagsA ( NIL,
  109.                     I.waLeft,          left,
  110.                     I.waTop,           top,
  111.                     I.waWidth,         width,
  112.                     I.waHeight,        height,
  113.                     I.waIDCMP,         LONGSET {I.closeWindow,I.refreshWindow,I.vanillaKey,I.menuPick},
  114.                     I.waFlags,         LONGSET {I.windowDrag,I.windowDepth,I.windowClose,I.activate,I.newLookMenus},
  115.                     I.waTitle,         y.ADR ("Generating..."),
  116.                     I.waScreenTitle,   y.ADR ("CloudsAGA 1.05 © Danny Amor in 1994"),
  117.                     I.waPubScreen,     GUI.Scr,
  118.                     I.waMinWidth,      67,
  119.                     I.waMinHeight,     21,
  120.                     I.waMaxWidth,      656,
  121.                     I.waMaxHeight,     414, u.done);
  122.  
  123.   IF version>38 THEN
  124.     I.LendMenus(GUI.CloudsWnd,GUI.PaletteWnd);
  125. (*    quit:=I.SetMenuStrip(GUI.PaletteWnd,GUI.Menu^);*)
  126.   END;
  127.   gt.RefreshWindow (win, NIL);
  128. END OpenWindow;
  129.  
  130. PROCEDURE CloseWindow (VAR win: I.WindowPtr);
  131.  
  132. BEGIN
  133.   IF win # NIL THEN
  134.     I.CloseWindow (win);
  135.     win := NIL;
  136.   END;
  137. END CloseWindow;
  138.  
  139. PROCEDURE TestF(VAR farbe: INTEGER);
  140.  
  141. BEGIN
  142.   IF farbe>ObereFarbe  THEN farbe:=ObereFarbe;  END;
  143.   IF farbe<UntereFarbe THEN farbe:=UntereFarbe; END;
  144. END TestF;
  145.  
  146. PROCEDURE RandomFarbe(VAR Rp: g.RastPortPtr; Start: INTEGER; VAR mf: REAL; x,y: INTEGER);
  147.  
  148. VAR farbe: INTEGER;
  149.     OK   : BOOLEAN;
  150.  
  151. BEGIN
  152.   farbe:=SHORT(Start+SHORT(mf*(r.RND(1)*LONG(2)-1))+1);
  153.   TestF(farbe);
  154.   g.SetAPen(Rp,farbe);
  155.   OK:=g.WritePixel(Rp,x+4,y+fonty);
  156. END RandomFarbe;
  157.  
  158. PROCEDURE Cloud(numiter: INTEGER; mu: REAL; na: INTEGER);
  159.  
  160. TYPE Coord = ARRAY 11 OF INTEGER;
  161.  
  162. VAR i,j,k,l,x1,y1,x2,y2,x3,y3,smul1,smul2,p  : INTEGER;
  163.     xy                                       : Coord;
  164.     n,n1,farbe,nk,test,test2                 : INTEGER;
  165.     farbe1,farbe2,farbe3,farbe4              : LONGINT;
  166.     mf                                       : REAL;
  167.  
  168.   PROCEDURE BigPic(n,i: INTEGER; VAR n1,l: INTEGER);
  169.  
  170.   VAR q: INTEGER;
  171.  
  172.   BEGIN
  173.    n1:=n DIV 2;
  174.    l:=1;
  175.    FOR q:=1 TO i DO l:=l*2; END;
  176.   END BigPic;
  177.  
  178.   PROCEDURE SetEdge(VAR Rp: g.RastPortPtr; x1,y1,x2,y2,x3,y3: INTEGER; VAR mf: REAL);
  179.  
  180.   BEGIN
  181.     farbe1:=g.ReadPixel(Rp,x1+4,y1+fonty);
  182.     farbe2:=g.ReadPixel(Rp,x2+4,y2+fonty);
  183.     RandomFarbe(Rp,SHORT(farbe1+farbe2) DIV 2,mf,x3,y3);
  184.   END SetEdge;
  185.  
  186.  PROCEDURE SetPoint(VAR Rp: g.RastPortPtr; VAR mf: REAL; VAR xy: Coord);
  187.  
  188.   VAR a: BOOLEAN;
  189.  
  190.   BEGIN
  191.     farbe1:=g.ReadPixel(Rp,xy[1]+4,xy[2]+fonty);
  192.     farbe2:=g.ReadPixel(Rp,xy[3]+4,xy[4]+fonty);
  193.     farbe3:=g.ReadPixel(Rp,xy[5]+4,xy[6]+fonty);
  194.     farbe4:=g.ReadPixel(Rp,xy[7]+4,xy[8]+fonty);
  195.     farbe:=SHORT(((farbe1+farbe2+farbe3+farbe4) DIV 4)+SHORT(r.RND(2)*2*mf-mf));
  196.     TestF(farbe);
  197.     g.SetAPen(Rp,farbe);
  198.     a:=g.WritePixel(Rp,xy[9]+4,xy[10]+fonty);
  199.   END SetPoint;
  200.  
  201. BEGIN
  202.   mf:=(numiter+1)*mu;
  203.   RandomFarbe(win^.rPort,MittlereFarbe,mf,0,  0);
  204.   RandomFarbe(win^.rPort,MittlereFarbe,mf,0, na);
  205.   RandomFarbe(win^.rPort,MittlereFarbe,mf,na, 0);
  206.   RandomFarbe(win^.rPort,MittlereFarbe,mf,na,na);
  207.   n:=na;
  208.   test:=1;
  209.   FOR i:=0 TO numiter DO
  210.     mf:=(numiter-i+1)*mu;
  211.     BigPic(n,i,n1,l);
  212.     FOR j:=1 TO l DO
  213.       smul1:=(j-1)*n;
  214.       smul2:=j*n;
  215.       SetEdge(win^.rPort,smul1,0    ,smul2,0    ,smul2-n1,0       ,mf);
  216.       SetEdge(win^.rPort,smul1,na   ,smul2,na   ,smul2-n1,na      ,mf);
  217.       SetEdge(win^.rPort,0    ,smul1,0    ,smul2,0       ,smul2-n1,mf);
  218.       SetEdge(win^.rPort,na   ,smul1,na   ,smul2,na      ,smul2-n1,mf);
  219.     END;
  220.     n:=n1;
  221.   END;
  222.   n:=na;
  223.   FOR i:=0 TO numiter DO
  224.     mf:=(numiter-i+1)*mu;
  225.     BigPic(n,i,n1,l);
  226.     FOR k:=1 TO l DO
  227.       FOR j:=1 TO l DO
  228.         smul1:=k*n;   smul2:=j*n;
  229.         xy[1]:=smul2-n; xy[2]:=smul1-n; xy[3]:=smul2-n;
  230.         xy[4]:=smul1  ; xy[5]:=smul2  ; xy[6]:=smul1-n;
  231.         xy[7]:=smul2  ; xy[8]:=smul1  ; xy[9]:=smul2-n1;
  232.         xy[10]:=smul1-n1;
  233.         SetPoint(win^.rPort,mf,xy);
  234.       END;
  235.     END;
  236.     nk:=0;
  237.     FOR k:=1 TO test DO
  238.       nk:=1-nk;
  239.       test2:=1;
  240.       FOR p:=1 TO i DO test2:=test2*2; END;
  241.       test2:=test2-nk;
  242.       FOR j:=1 TO test2 DO
  243.         smul1:=j*n+nk*n1;   smul2:=k*n1;
  244.         xy[1]:=smul1-n1; xy[2]:=smul2-n1; xy[3]:=smul1;
  245.         xy[4]:=smul2   ; xy[5]:=smul1-n1; xy[6]:=smul2+n1;
  246.         xy[7]:=smul1-n ; xy[8]:=smul2   ; xy[9]:=smul1-n1;
  247.         xy[10]:=smul2;
  248.         SetPoint(win^.rPort,mf,xy);
  249.       END;
  250.     END;
  251.     n:=n1;
  252.     test:=((test+1)*2)-1;
  253.   END;
  254.   I.SetWindowTitles(win,y.ADR("OK!"),y.ADR("CloudsAGA 1.05 © Danny Amor in 1994"));
  255. END Cloud;
  256.  
  257. PROCEDURE SizeOut(VAR na: INTEGER; faktor,size: INTEGER);
  258.  
  259. VAR numiter: INTEGER;
  260.     mu     : REAL;
  261.  
  262. BEGIN
  263.   IF size=0 THEN
  264.     na:=64;
  265.     numiter:=5;
  266.     faktor:=2;
  267.   END;
  268.   IF size=1 THEN
  269.     na:=128;
  270.     numiter:=6;
  271.     faktor:=3;
  272.   END;
  273.   IF size=2 THEN
  274.     na:=256;
  275.     numiter:=7;
  276.     faktor:=4;
  277.   END;
  278.   IF size=3 THEN
  279.     na:=512;
  280.     numiter:=8;
  281.     faktor:=5;
  282.   END;
  283.   mu:=2.5-faktor/5;
  284.   Cloud(numiter,mu,na);
  285. END SizeOut;
  286.  
  287. PROCEDURE Smooth(VAR na: INTEGER);
  288.  
  289. VAR y1,x,farbe                 : INTEGER;
  290.     a                          : BOOLEAN;
  291.     farbe1,farbe2,farbe3,farbe4: LONGINT;
  292.  
  293. BEGIN
  294.   I.SetWindowTitles(win,y.ADR("Smoothing..."),y.ADR("CloudsAGA 1.05 © Danny Amor in 1994"));
  295.   FOR y1:=0 TO na-1 DO
  296.     FOR x:=0 TO na-1 DO
  297.       farbe1:=g.ReadPixel(win^.rPort,x+4,y1+fonty);
  298.       farbe2:=g.ReadPixel(win^.rPort,x+5,y1+fonty);
  299.       farbe3:=g.ReadPixel(win^.rPort,x+4,y1+1+fonty);
  300.       farbe4:=g.ReadPixel(win^.rPort,x+5,y1+1+fonty);
  301.       farbe :=SHORT(SHORT((farbe1+farbe2+farbe3+farbe4)/4));
  302.       g.SetAPen(win^.rPort,farbe);
  303.       a:=g.WritePixel(win^.rPort,x+4,y1+fonty);
  304.     END;
  305.   END;
  306.   I.SetWindowTitles(win,y.ADR("OK!"),y.ADR("CloudsAGA 1.05 © Danny Amor in 1994"));
  307. END Smooth;
  308.  
  309. PROCEDURE SetColors(VAR vp: g.ViewPortPtr);
  310.  
  311. VAR a,i,nf,n: INTEGER;
  312.  
  313. BEGIN
  314.   IF version<39 THEN
  315.     g.SetRGB4(vp,0,10,10,10);
  316.     g.SetRGB4(vp,1,0,0,0);
  317.     g.SetRGB4(vp,2,15,15,15);
  318.     g.SetRGB4(vp,3,6,8,11);
  319.     nf:=1;  n:=UntereFarbe+1;
  320.     g.SetRGB4(vp,4,0,0,15);
  321.     FOR i:=4 TO 14 DO
  322.       g.SetRGB4(vp,n,i,i,15);
  323.       INC(n);
  324.     END;
  325.     g.SetRGB4(vp,n,15,15,15);
  326.     INC(n);
  327.     FOR i:=14 TO 10 DO
  328.       g.SetRGB4(vp,n,i,i,i+1);
  329.       INC(n);
  330.     END;
  331.     FOR i:=1 TO 10 DO
  332.       a:=1;
  333.       IF i>2 THEN a:=5-i END;
  334.       IF i>7 THEN a:=i-10 END;
  335.       a:=(10-a);
  336.       g.SetRGB4(vp,n,a,a,a+1);
  337.       INC(n);
  338.     END;
  339.   ELSE
  340.     g.SetRGB32(vp,0,0AC000000H,0AC000000H,0AC000000H);
  341.     g.SetRGB32(vp,1,0,0,0);
  342.     g.SetRGB32(vp,2,0FF000000H,0FF000000H,0FF000000H);
  343.     g.SetRGB32(vp,3,066000000H,088000000H,0BA000000H);
  344.     IF depth=5 THEN
  345.       colours32:=colourstype32(1C0004H,000000000H,000000000H,0FF000000H, 000000000H,010000000H,0FF000000H,
  346.                                      000000000H,020000000H,0FF000000H, 000000000H,030000000H,0FF000000H,
  347.                                      000000000H,040000000H,0FF000000H, 000000000H,050000000H,0FF000000H,
  348.                                      000000000H,060000000H,0FF000000H, 000000000H,070000000H,0FF000000H,
  349.                                      010000000H,080000000H,0FF000000H, 020000000H,08A000000H,0FF000000H,
  350.                                      030000000H,090000000H,0FF000000H, 040000000H,09A000000H,0FF000000H,
  351.                                      050000000H,0A0000000H,0FF000000H, 060000000H,0AA000000H,0FF000000H,
  352.                                      070000000H,0B0000000H,0FF000000H, 080000000H,0BA000000H,0FF000000H,
  353.                                      090000000H,0C0000000H,0FF000000H, 0A0000000H,0CA000000H,0FF000000H,
  354.                                      0B0000000H,0D0000000H,0FF000000H, 0C0000000H,0DA000000H,0FF000000H,
  355.                                      0D0000000H,0E0000000H,0FF000000H, 0E0000000H,0EA000000H,0FF000000H,
  356.                                      0F0000000H,0F0000000H,0FF000000H, 0E0000000H,0E0000000H,0EF000000H,
  357.                                      0D0000000H,0D0000000H,0DF000000H, 0C0000000H,0C0000000H,0CF000000H,
  358.                                      0B0000000H,0B0000000H,0BF000000H, 0A0000000H,0A0000000H,0AF000000H,0);
  359.  
  360.       g.LoadRGB32(vp,colours32);
  361.     END;
  362.     IF depth=6 THEN
  363.       colours64:=colourstype64(3C0004H,000000000H,000000000H,0FF000000H, 000000000H,008000000H,0FF000000H,
  364.                                      000000000H,010000000H,0FF000000H, 000000000H,018000000H,0FF000000H,
  365.                                      000000000H,020000000H,0FF000000H, 000000000H,028000000H,0FF000000H,
  366.                                      000000000H,030000000H,0FF000000H, 000000000H,038000000H,0FF000000H,
  367.                                      000000000H,040000000H,0FF000000H, 000000000H,048000000H,0FF000000H,
  368.                                      000000000H,050000000H,0FF000000H, 000000000H,058000000H,0FF000000H,
  369.                                      000000000H,060000000H,0FF000000H, 000000000H,068000000H,0FF000000H,
  370.                                      000000000H,070000000H,0FF000000H, 000000000H,078000000H,0FF000000H,
  371.                                      010000000H,080000000H,0FF000000H, 018000000H,088000000H,0FF000000H,
  372.                                      020000000H,08A000000H,0FF000000H, 028000000H,08C000000H,0FF000000H,
  373.                                      030000000H,090000000H,0FF000000H, 038000000H,098000000H,0FF000000H,
  374.                                      040000000H,09A000000H,0FF000000H, 048000000H,09C000000H,0FF000000H,
  375.                                      050000000H,0A0000000H,0FF000000H, 058000000H,0A8000000H,0FF000000H,
  376.                                      060000000H,0AA000000H,0FF000000H, 068000000H,0AC000000H,0FF000000H,
  377.                                      070000000H,0B0000000H,0FF000000H, 078000000H,0B8000000H,0FF000000H,
  378.                                      080000000H,0BA000000H,0FF000000H, 088000000H,0BC000000H,0FF000000H,
  379.                                      090000000H,0C0000000H,0FF000000H, 098000000H,0C8000000H,0FF000000H,
  380.                                      0A0000000H,0CA000000H,0FF000000H, 0A8000000H,0CC000000H,0FF000000H,
  381.                                      0B0000000H,0D0000000H,0FF000000H, 0B8000000H,0D8000000H,0FF000000H,
  382.                                      0C0000000H,0DA000000H,0FF000000H, 0C8000000H,0DC000000H,0FF000000H,
  383.                                      0D0000000H,0E0000000H,0FF000000H, 0D8000000H,0E8000000H,0FF000000H,
  384.                                      0E0000000H,0EA000000H,0FF000000H, 0E8000000H,0EC000000H,0FF000000H,
  385.                                      0F0000000H,0F0000000H,0FF000000H, 0F8000000H,0F8000000H,0FF000000H,
  386.                                      0E8000000H,0E0000000H,0EF000000H, 0E0000000H,0E8000000H,0EF000000H,
  387.                                      0D8000000H,0D0000000H,0DF000000H, 0D0000000H,0D8000000H,0DF000000H,
  388.                                      0C8000000H,0C0000000H,0CF000000H, 0C0000000H,0C8000000H,0CF000000H,
  389.                                      0B8000000H,0B0000000H,0BF000000H, 0B0000000H,0B8000000H,0BF000000H,
  390.                                      0A8000000H,0A0000000H,0AF000000H, 0A0000000H,0A8000000H,0AF000000H,
  391.                                      09F000000H,09F000000H,09F000000H, 09A000000H,09A000000H,09A000000H,
  392.                                      098000000H,098000000H,098000000H, 094000000H,094000000H,094000000H,0);
  393.      g.LoadRGB32(vp,colours64);
  394.    END;
  395.     IF depth=7 THEN
  396.       colours128:=colourstype128(7C0004H,000000000H,000000000H,0FF000000H, 000000000H,004000000H,0FF000000H,
  397.                                      000000000H,008000000H,0FF000000H, 000000000H,00B000000H,0FF000000H,
  398.                                      000000000H,010000000H,0FF000000H, 000000000H,014000000H,0FF000000H,
  399.                                      000000000H,018000000H,0FF000000H, 000000000H,01B000000H,0FF000000H,
  400.                                      000000000H,020000000H,0FF000000H, 000000000H,024000000H,0FF000000H,
  401.                                      000000000H,028000000H,0FF000000H, 000000000H,02B000000H,0FF000000H,
  402.                                      000000000H,030000000H,0FF000000H, 000000000H,034000000H,0FF000000H,
  403.                                      000000000H,038000000H,0FF000000H, 000000000H,03B000000H,0FF000000H,
  404.                                      000000000H,040000000H,0FF000000H, 000000000H,044000000H,0FF000000H,
  405.                                      000000000H,048000000H,0FF000000H, 000000000H,04B000000H,0FF000000H,
  406.                                      000000000H,050000000H,0FF000000H, 000000000H,054000000H,0FF000000H,
  407.                                      000000000H,058000000H,0FF000000H, 000000000H,05B000000H,0FF000000H,
  408.                                      000000000H,060000000H,0FF000000H, 000000000H,064000000H,0FF000000H,
  409.                                      000000000H,068000000H,0FF000000H, 000000000H,06B000000H,0FF000000H,
  410.                                      000000000H,070000000H,0FF000000H, 000000000H,074000000H,0FF000000H,
  411.                                      000000000H,078000000H,0FF000000H, 000000000H,07B000000H,0FF000000H,
  412.                                      010000000H,080000000H,0FF000000H, 014000000H,084000000H,0FF000000H,
  413.                                      016000000H,088000000H,0FF000000H, 018000000H,08B000000H,0FF000000H,
  414.                                      020000000H,08A000000H,0FF000000H, 024000000H,08B000000H,0FF000000H,
  415.                                      026000000H,08C000000H,0FF000000H, 028000000H,08D000000H,0FF000000H,
  416.                                      030000000H,090000000H,0FF000000H, 034000000H,094000000H,0FF000000H,
  417.                                      036000000H,098000000H,0FF000000H, 038000000H,09B000000H,0FF000000H,
  418.                                      040000000H,09A000000H,0FF000000H, 044000000H,09B000000H,0FF000000H,
  419.                                      046000000H,09C000000H,0FF000000H, 048000000H,09D000000H,0FF000000H,
  420.                                      050000000H,0A0000000H,0FF000000H, 054000000H,0A4000000H,0FF000000H,
  421.                                      056000000H,0A8000000H,0FF000000H, 058000000H,0AB000000H,0FF000000H,
  422.                                      060000000H,0AA000000H,0FF000000H, 064000000H,0AB000000H,0FF000000H,
  423.                                      066000000H,0AC000000H,0FF000000H, 068000000H,0AD000000H,0FF000000H,
  424.                                      070000000H,0B0000000H,0FF000000H, 074000000H,0B4000000H,0FF000000H,
  425.                                      076000000H,0B8000000H,0FF000000H, 078000000H,0BB000000H,0FF000000H,
  426.                                      080000000H,0BA000000H,0FF000000H, 084000000H,0BB000000H,0FF000000H,
  427.                                      088000000H,0BC000000H,0FF000000H, 08B000000H,0BD000000H,0FF000000H,
  428.                                      090000000H,0C0000000H,0FF000000H, 098000000H,0C8000000H,0FF000000H,
  429.                                      0A0000000H,0CA000000H,0FF000000H, 0A8000000H,0CC000000H,0FF000000H,
  430.                                      0B0000000H,0D0000000H,0FF000000H, 0B8000000H,0D8000000H,0FF000000H,
  431.                                      0C0000000H,0DA000000H,0FF000000H, 0C8000000H,0DC000000H,0FF000000H,
  432.                                      0D0000000H,0E0000000H,0FF000000H, 0D8000000H,0E8000000H,0FF000000H,
  433.                                      0E0000000H,0EA000000H,0FF000000H, 0E8000000H,0EC000000H,0FF000000H,
  434.                                      0F0000000H,0F0000000H,0FF000000H, 0F8000000H,0F8000000H,0FF000000H,
  435.                                      0E8000000H,0E0000000H,0EF000000H, 0E0000000H,0E8000000H,0EF000000H,
  436.                                      0D8000000H,0D0000000H,0DF000000H, 0D0000000H,0D8000000H,0DF000000H,
  437.                                      0C8000000H,0C0000000H,0CF000000H, 0C0000000H,0C8000000H,0CF000000H,
  438.                                      0B8000000H,0B0000000H,0BF000000H, 0B0000000H,0B8000000H,0BF000000H,
  439.                                      0A8000000H,0A0000000H,0AF000000H, 0A0000000H,0A8000000H,0AF000000H,
  440.                                      09F000000H,09F000000H,09F000000H, 09A000000H,09A000000H,09A000000H,
  441.                                      098000000H,098000000H,098000000H, 094000000H,094000000H,094000000H,
  442.                                      0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0,
  443.                                      0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0,
  444.                                      0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0,
  445.                                      0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0, 0,0,0,
  446.                                      0);
  447.      g.LoadRGB32(vp,colours128);
  448.    END;
  449.  END (* IF THEN ELSE *);
  450. END SetColors;
  451.  
  452. PROCEDURE ClickNull(VAR size: INTEGER);
  453.  
  454. BEGIN
  455.   INC(size);
  456.   IF size>3 THEN size:=0; END;
  457.   gt.SetGadgetAttrs(GUI.CloudsGadgets[0]^,GUI.CloudsWnd,NIL,gt.cyActive,size);
  458. END ClickNull;
  459.  
  460. PROCEDURE ClickOne(VAR x,y: INTEGER);
  461.  
  462. VAR q  : INTEGER;
  463.  
  464. BEGIN
  465.   x:=64;
  466.   y:=64;
  467.   FOR q:=1 TO size DO x:=x*2; y:=y*2; END;
  468.   x:=x+10;
  469.   y:=y+fonty+4;
  470.   OpenWindow(0,0,x,y,win);
  471.   open:=TRUE;
  472.   I.WindowToFront(GUI.CloudsWnd);
  473.   SizeOut(na,4,size);
  474. END ClickOne;
  475.  
  476. PROCEDURE GetColour(VAR Col32: colourstype128; VAR colourNoAGA: colourArray; VAR depth: LONGINT);
  477.  
  478. VAR i,aha: LONGINT;
  479.  
  480. BEGIN
  481.   IF version>38 THEN
  482.     aha:=1;
  483.     FOR i:=1 TO depth DO aha:=aha*2; END;
  484.     g.GetRGB32(GUI.Scr^.viewPort.colorMap,0,aha,Col32);
  485.     FOR i:=0 TO 277 DO Col32[277-i+1]:=Col32[277-i]; END;
  486.     Col32[0]:=010000H*aha;
  487.   ELSE
  488.     FOR i:=0 TO 32 DO
  489.       colourNoAGA[i]:=g.GetRGB4(GUI.Scr^.viewPort.colorMap,i);
  490.     END;
  491.   END;
  492. END GetColour;
  493.  
  494. PROCEDURE SetSlider(VAR Col32: colourstype128; VAR colourNoAGA: colourArray; VAR colornum: INTEGER);
  495.  
  496. VAR blue,green,red,i : INTEGER;
  497.  
  498. BEGIN
  499.   IF version>38 THEN
  500.     red   := SHORT(Col32[colornum*3+1] DIV 001000000H);
  501.     green := SHORT(Col32[colornum*3+2] DIV 001000000H);
  502.     blue  := SHORT(Col32[colornum*3+3] DIV 001000000H);
  503.     IF red<0   THEN red  :=256+red; END;
  504.     IF green<0 THEN green:=256+green; END;
  505.     IF blue<0  THEN blue :=256+blue; END;
  506.   ELSE
  507.     red   := y.LSH(colourNoAGA[colornum],-8);
  508.     green := y.LSH(y.LSH(colourNoAGA[colornum],8),-12);
  509.     blue  := y.LSH(y.LSH(colourNoAGA[colornum],12),-12);
  510.   END;
  511.   gt.SetGadgetAttrs(GUI.PaletteGadgets[0]^,GUI.PaletteWnd,NIL,gt.slLevel,red);
  512.   gt.SetGadgetAttrs(GUI.PaletteGadgets[1]^,GUI.PaletteWnd,NIL,gt.slLevel,green);
  513.   gt.SetGadgetAttrs(GUI.PaletteGadgets[2]^,GUI.PaletteWnd,NIL,gt.slLevel,blue);
  514. END SetSlider;
  515.  
  516. PROCEDURE SetColor(VAR Col32: colourstype128; VAR colourNoAGA: colourArray; VAR vp: g.ViewPortPtr;
  517.                    VAR colornum: INTEGER; coltype: INTEGER; VAR count: INTEGER);
  518.  
  519. VAR red,green,blue,col: INTEGER;
  520.  
  521. BEGIN
  522.   IF version>38 THEN
  523.     col:=colornum*3;
  524.     Col32[col+coltype]:=count*001000000H;
  525.     g.SetRGB32(vp,colornum,Col32[col+1],Col32[col+2],Col32[col+3]);
  526.   ELSE
  527.     red   := y.LSH(colourNoAGA[colornum],-8);
  528.     green := y.LSH(y.LSH(colourNoAGA[colornum],8),-12);
  529.     blue  := y.LSH(y.LSH(colourNoAGA[colornum],12),-12);
  530.     IF coltype=1 THEN red   := count; END;
  531.     IF coltype=2 THEN green := count; END;
  532.     IF coltype=3 THEN blue  := count; END;
  533.     g.SetRGB4(vp,colornum,red,green,blue);
  534.     red   := y.LSH(red,8);
  535.     green := y.LSH(green,4);
  536.     colourNoAGA[colornum]:=red+green+blue;
  537.  END;
  538. END SetColor;
  539.  
  540. PROCEDURE ClickTwo(VAR vp: g.ViewPortPtr; VAR depth: LONGINT);
  541.  
  542. VAR quit                 : BOOLEAN;
  543.     aktgad               : I.GadgetPtr;
  544.     nummer, colornum,info: INTEGER;
  545.  
  546. BEGIN
  547.   req.Assert(GUI.OpenPaletteWindow(depth)=0,"Unable to open palette window!");
  548.   GetColour(Col32,colourNoAGA,depth);
  549.   Col32copy:=Col32;
  550.   colourNoAGAcopy:=colourNoAGA;
  551.   colornum:=3;
  552.   quit:=FALSE;
  553.   SetSlider(Col32copy,colourNoAGAcopy,colornum);
  554.   REPEAT
  555.     e.WaitPort(GUI.PaletteWnd.userPort);
  556.     msgptr := gt.GetIMsg (GUI.PaletteWnd.userPort);
  557.     IF msgptr#NIL THEN
  558.       msg  := msgptr^;
  559.       info := msg.code;
  560.       gt.ReplyIMsg (msgptr);
  561.       IF (I.gadgetUp IN msg.class) THEN
  562.         aktgad:=msg.iAddress;
  563.         nummer:=aktgad.gadgetID;
  564.         IF nummer=GUI.GDPACANCEL  THEN
  565.           IF version>38 THEN g.LoadRGB32(vp,Col32);
  566.                         ELSE g.LoadRGB4(vp,colourNoAGA,32); END;
  567.           quit:=TRUE;
  568.         END;
  569.         IF nummer=GUI.GDPARED     THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,1,info); END;
  570.         IF nummer=GUI.GDPAGREEN   THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,2,info); END;
  571.         IF nummer=GUI.GDPABLUE    THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,3,info); END;
  572.         IF nummer=GUI.GDPAOK      THEN quit:=TRUE; END;
  573.         IF nummer=GUI.GDPAPALETTE THEN colornum:=info; SetSlider(Col32copy,colourNoAGAcopy,colornum); END;
  574.         IF nummer=GUI.GDPARESET   THEN SetColors(vp); GetColour(Col32copy,colourNoAGAcopy,depth); SetSlider(Col32copy,colourNoAGAcopy,colornum); END;
  575.       ELSE
  576.         IF (I.mouseMove IN msg.class) THEN
  577.           aktgad:=msg.iAddress;
  578.           nummer:=aktgad.gadgetID;
  579.           IF nummer=GUI.GDPARED     THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,1,info); END;
  580.           IF nummer=GUI.GDPAGREEN   THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,2,info); END;
  581.           IF nummer=GUI.GDPABLUE    THEN SetColor(Col32copy,colourNoAGAcopy,vp,colornum,3,info); END;
  582.         END;
  583.       END;
  584.     END;
  585.   UNTIL quit;
  586.   GUI.ClosePaletteWindow;
  587. END ClickTwo;
  588.  
  589. PROCEDURE ClickThree;
  590.  
  591. BEGIN
  592.   Smooth(na);
  593. END ClickThree;
  594.  
  595. PROCEDURE ClickFour(x,y1: INTEGER);
  596.  
  597. VAR Ok   : BOOLEAN;
  598.     Name : ARRAY 80 OF CHAR;
  599.     xm,ym: LONGINT;
  600.  
  601. BEGIN
  602.   Name:="RAM:Clouds_1.IFF";
  603.   Ok:=FileReq("Save Clouds as...",Name,win);
  604.   IF Ok THEN
  605.     I.SetWindowTitles(win,y.ADR("Saving..."),y.ADR("CloudsAGA 1.05 © Danny Amor in 1994"));
  606.     I.WindowToBack(GUI.CloudsWnd);
  607.     xm:=win^.leftEdge DIV 8+(x DIV 8)+1;
  608.     ym:=win^.topEdge+y1;
  609.     IF xm>resx THEN xm:=(x DIV 8)+1-(xm-resx); END;
  610.     IF ym>resy THEN ym:=y1-(ym-resy); END;
  611.     req.Assert(IFF.SaveClip(y.ADR(Name),win^.rPort.bitMap,win^.wScreen^.viewPort.colorMap.colorTable,1,win^.leftEdge DIV 8,win^.topEdge,xm,ym),"Couldn't save picture!");
  612.     I.WindowToFront(GUI.CloudsWnd);
  613.     I.SetWindowTitles(win,y.ADR("OK!"),y.ADR("CloudsAGA 1.05 © Danny Amor in 1994"));
  614.   END;
  615. END ClickFour;
  616.  
  617. PROCEDURE DoColours;
  618.  
  619. VAR i: LONGINT;
  620.  
  621. BEGIN
  622.   ObereFarbe:=1;
  623.   FOR i:=1 TO depth DO ObereFarbe:=ObereFarbe*2; END;
  624.   DEC(ObereFarbe);
  625.   MittlereFarbe:=(ObereFarbe DIV 2)+SHORT(depth);
  626. END DoColours;
  627.  
  628. PROCEDURE ClickFive(VAR vp: g.ViewPortPtr);
  629.  
  630. VAR doit: BOOLEAN;
  631.  
  632. BEGIN
  633.   doit:=TRUE;
  634.   IF open THEN doit:=req.Request("Change Screenmode:","Do you want to restart with another\nresolution (this pic will be killed)?","OK","Cancel"); END;
  635.   IF doit THEN
  636.     CloseWindow(win);
  637.     GUI.ClosePaletteWindow;
  638.     GUI.CloseCloudsWindow(GUI.CloudsWnd);
  639.     GUI.CloseDownScreen(GUI.Scr);
  640.     req.Assert(GUI.SetupScreen(depth,resx,resy)=0,"Unable to open screen!");
  641.     DoColours;
  642.     vp:=y.ADR(GUI.Scr^.viewPort);
  643.     fonty:=GUI.FontY+3;
  644.     SetColors(vp);
  645.     size:=0;
  646.     req.Assert(GUI.OpenCloudsWindow(GUI.CloudsWnd,GUI.Scr)=0,"Unable to open window!");
  647.     open      := FALSE;
  648.     quit      := FALSE;
  649.   END;
  650. END ClickFive;
  651.  
  652. PROCEDURE WaitUntilClosedInfo;
  653.  
  654. VAR msg: I.IntuiMessagePtr;
  655.  
  656. BEGIN
  657.   e.WaitPort(GUI.InfoReqWnd.userPort);
  658.   msg:=e.GetMsg(GUI.InfoReqWnd.userPort);
  659.   e.ReplyMsg(msg);
  660.   GUI.CloseInfoReqWindow;
  661. END WaitUntilClosedInfo;
  662.  
  663. BEGIN
  664.   VERSION := "$VER: CloudsAGA 1.05 (26.02.94) by Daniel Amor, Ludwigstr. 124, 70197 Stuttgart, Germany";
  665.   version := g.gfx.libNode.version;
  666.   depth   := 5;
  667.   req.Assert (GUI.SetupScreen(depth,resx,resy) = 0, "Unable to open screen!");
  668.   req.Assert (GUI.OpenCloudsWindow(GUI.CloudsWnd,GUI.Scr) = 0, "Unable to open window!");
  669.   quit    := FALSE;
  670.   open    := FALSE;
  671.   DoColours;
  672.   vp:=y.ADR(GUI.Scr^.viewPort);
  673.   SetColors(vp);
  674.   fonty:=GUI.FontY+3;
  675.   size:=0;
  676.   REPEAT
  677.     IF open THEN
  678.       quit := (d.ctrlC IN e.Wait (LONGSET {GUI.CloudsWnd.userPort.sigBit,
  679.                                            win.userPort.sigBit,
  680.                                            d.ctrlC}))
  681.     ELSE
  682.       quit := (d.ctrlC IN e.Wait (LONGSET {GUI.CloudsWnd.userPort.sigBit,
  683.                                            d.ctrlC}));
  684.     END;
  685.     msgptr1 := gt.GetIMsg (GUI.CloudsWnd.userPort);
  686.     IF msgptr1 # NIL THEN
  687.       msg1 := msgptr1^;
  688.       gt.ReplyIMsg (msgptr1);
  689.  
  690.       IF (I.closeWindow IN msg1.class) THEN
  691.         quit := req.RequestWin("Clouds Requester","Do you really want to quit?","Yes","No",GUI.CloudsWnd);
  692.       END;
  693.       IF (I.gadgetUp IN msg1.class) THEN
  694.         aktgad1:=msg1.iAddress;
  695.         nummer:=aktgad1.gadgetID;
  696.         IF  nummer=GUI.GDSize                   THEN size:=msg1.code; END;
  697.         IF (nummer=GUI.GDCreate) AND (NOT open) THEN ClickOne(wx,wy);  END;
  698.         IF  nummer=GUI.GDAnimate                THEN ClickTwo(vp,depth);  END;
  699.         IF (nummer=GUI.GDSmooth) AND open       THEN ClickThree;END;
  700.         IF (nummer=GUI.GDSave) AND open         THEN ClickFour(wx,wy); END;
  701.         IF  nummer=GUI.GDScreen                 THEN ClickFive(vp); END;
  702.       END;
  703.       IF (I.vanillaKey IN msg1.class) THEN
  704.         key:=CAP(CHR(msg1.code));
  705.         IF  key="Z"                 THEN ClickNull(size);   END;
  706.         IF (key="C") AND (NOT open) THEN ClickOne(wx,wy);   END;
  707.         IF  key="P"                 THEN ClickTwo(vp,depth);END;
  708.         IF (key="M") AND open       THEN ClickThree;        END;
  709.         IF (key="S") AND open       THEN ClickFour(wx,wy);  END;
  710.         IF  key="R"                 THEN ClickFive(vp);     END;
  711.       END;
  712.       IF (I.menuPick IN msg1.class) THEN
  713.         IF I.MenuNum(msg1.code)=0 THEN
  714.           IF I.ItemNum(msg1.code)=0 THEN
  715.             req.Assert(GUI.OpenInfoReqWindow()=0, "Unable to open Info-Requester!");
  716.             WaitUntilClosedInfo;
  717.           END;
  718.           IF I.ItemNum(msg1.code)=2 THEN
  719.             quit := req.RequestWin("Clouds Requester","Do you really want to quit?","Yes","No",GUI.CloudsWnd);
  720.           END;
  721.         END;
  722.       END;
  723.     ELSE
  724.       IF NOT quit THEN
  725.         msgptr2 := gt.GetIMsg (win.userPort);
  726.         IF msgptr2 # NIL THEN
  727.           msg2 := msgptr2^;
  728.           gt.ReplyIMsg (msgptr2);
  729.  
  730.           IF (I.vanillaKey IN msg2.class) THEN
  731.             key:=CAP(CHR(msg2.code));
  732.             IF  key="Z"                 THEN ClickNull(size);   END;
  733.             IF  key="P"                 THEN ClickTwo(vp,depth);END;
  734.             IF (key="M") AND open       THEN ClickThree;        END;
  735.             IF (key="S") AND open       THEN ClickFour(wx,wy);  END;
  736.             IF  key="R"                 THEN ClickFive(vp);     END;
  737.           END;
  738.           IF (I.closeWindow IN msg2.class) THEN
  739.             CloseWindow(win);
  740.             open := FALSE;
  741.           END;
  742.         END;
  743.       END;
  744.     END;
  745.   UNTIL quit;
  746. CLOSE
  747.   CloseWindow(win);
  748.   GUI.CloseCloudsWindow(GUI.CloudsWnd);
  749.   GUI.ClosePaletteWindow;
  750.   GUI.CloseDownScreen(GUI.Scr);
  751.   GUI.CloseDownScreen(Scr2);
  752. END Clouds.
  753.